home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / show.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-06-04  |  5.8 KB  |  174 lines
  1. 10    'This program was written as a supplemental,  or support,  program 
  2. 20    'to accompany the Picture Graphics System written by Eugene  Ying.  
  3. 30    'It's sole purpose is to provide a slideshow effect from graphs B-
  4. 40    'saved  from  PCPG via F3.   There is a minimal  ordering  scheme.  
  5. 50    'Files  with  .PIC  extension are sorted alphabetically  prior  to 
  6. 60    'display.  Ordering may be accomplished via RENAME or by selecting 
  7. 70    'files names carefully when BSaving the graphs.
  8. 80    '
  9. 90    ' PCPG  has  a graphics print dump routine,  but I  found  that  it
  10. 100    'didn't  work  properly with either the Epson FX or the newer  IBM 
  11. 110    'graphic printers.  Screens can be printed from PCPG via the PrtSc 
  12. 120    'key  if  the IBM GRAPHICS.COM program has  been  previously  run.  
  13. 130    'Screens  can  be  printed via program control from  this  program 
  14. 140    'under the same circumstances, ei; GRAPHICS.COM installed.
  15. 150    '
  16. 160    'Enjoy.   John L. O'Boyle - March 1984
  17. 180        '**INITIAL PROGRAM**
  18. 190        SCREEN 0,0,0:WIDTH 80:COLOR 15,9,2:CLS:KEY OFF
  19. 200       GOSUB 440
  20. 210  LOCATE 4,34:PRINT "Presenting....";:LOCATE 7,33:PRINT "The Slide Show"
  21. 220  DIM A$(15):COLOR 15,9,2
  22. 230  A$(13)= "              Personal Computer     "
  23. 240  A$(14)= "                                   "
  24. 250  A$(3) = "********   ************     *******       *******"
  25. 260  A$(4) = "********   **************   ********     ********"
  26. 270  A$(5) = "  ****       ****    ****     *******   *******  "
  27. 280  A$(6) = "  ****       **********       ******** ********  "
  28. 290  A$(7) = "  ****       **********       **** ******* ****  "
  29. 300  A$(8) = "  ****       ****    ****     ****  *****  ****  "
  30. 310  A$(9) = "********   **************   ******   ***   ******"
  31. 320  A$(10)= "********   ************     ******    *    ******"
  32. 330  FOR I=10 TO 70:FOR J=3 TO 10:LOCATE J+6,I:PRINT CHR$(220);
  33. 340  NEXT J:SOUND 100+RND*3000,1:NEXT I
  34. 350  FOR I=10 TO 14:FOR J=3 TO 10:LOCATE J+6,I:PRINT " ";
  35. 360  NEXT J:SOUND 100+RND*3000,1:NEXT I
  36. 370  FOR I=15 TO 64:FOR J=3 TO 10:IF MID$(A$(J),I-14,1)=" "THEN LOCATE J+6,I:        PRINT " ";
  37. 380  NEXT J:SOUND 100+RND*3000,1:NEXT I
  38. 390  FOR I=64 TO 70:FOR J=3 TO 10:LOCATE J+6,I:PRINT " ";
  39. 400  NEXT J:SOUND 100+RND*3000,1:NEXT I:SOUND 100+RND*3000,1
  40. 410  LOCATE 19,15: PRINT SPACE$(3)+A$(13):SOUND 100+RND*3000,4
  41. 420  LOCATE 21,15: PRINT SPACE$(3)+A$(14):SOUND 100+RND*3000,1:GOSUB 480
  42. 430  GOTO 510
  43. 440  '*BOX SUB**
  44. 450  CLS:LOCATE 2,2,0:PRINT CHR$(201)+STRING$(75,205)+CHR$(187);
  45. 460  FOR I%=1 TO 20:LOCATE 2+I%,2:PRINT CHR$(186):LOCATE 2+I%,78:PRINT CHR$(         186);:NEXT
  46. 470  LOCATE 23,2,0:PRINT CHR$(200)+STRING$(75,205)+CHR$(188);:RETURN
  47. 480  '**CONT**
  48. 490  'LOCATE 23,28,0:COLOR 31,9,2:PRINT"Press Space Bar To Continue";:COLOR 15,9,2
  49. 500  'MT$=INKEY$:IF MT$="" THEN 490 ELSE IF MT$=" " THEN RETURN ELSE 490
  50. 510  FOR YYY = 1 TO 2500:NEXT YYY
  51. 520  FALSE=0:TRUE=NOT FALSE:DEFINT A-Z:L=0:CLS:CODE=43:DIM F$(175)
  52. 530  KEY OFF:PRTSC$ = "N"
  53. 540  F=7:B=0:BD=0
  54. 550  'SCREEN 1,0
  55. 560  'COLOR B,F,B
  56. 570  'BLOAD "OPEN.SCR"
  57. 580  'SP$=INKEY$:IF LEN(SP$)<>1 THEN 580
  58. 590  'IF SP$ <> " " THEN 580
  59. 600  FOR X = 1 TO 10:KEY (X) ON:NEXT
  60. 610  ON KEY(1) GOSUB 1530
  61. 620  ON KEY(2) GOSUB 1540
  62. 630  ON KEY(3) GOSUB 1550
  63. 640  ON KEY(4) GOSUB 1560
  64. 650  ON KEY(5) GOSUB 1570
  65. 660  ON KEY(6) GOSUB 1580
  66. 670  ON KEY(7) GOSUB 1590
  67. 680  ON KEY(8) GOSUB 1600
  68. 690  ON KEY(9) GOSUB 1610
  69. 700  ON KEY(10) GOSUB 1620
  70. 710  SCREEN 0:WIDTH 80
  71. 720  DIM PIC$(64)
  72. 730  COLOR F,B,BD:CLS:KEY OFF
  73. 740  LOCATE 5,8
  74. 750  PRINT"Which disk drive contains the slides?>  : ";
  75. 760  RICH$=INKEY$:IF LEN(RICH$)<>1 THEN  760
  76. 770  IF ASC(RICH$)>96 AND ASC(RICH$)<103 THEN RICH$=CHR$(ASC(RICH$)-32)
  77. 780  IF INSTR("ABCDEF",RICH$)<1 THEN BEEP:GOTO 740
  78. 790  DRIV$=LEFT$(RICH$,1)+":"
  79. 800  LOCATE 5,8
  80. 810  PRINT "Will the SlideShow be Manual or Automatic?"
  81. 820  LOCATE 7,28:PRINT "Enter M or A "
  82. 830  ANS$=INKEY$:IF LEN(ANS$)<>1 THEN 830
  83. 840  IF INSTR("MAma",ANS$)<1 THEN BEEP:GOTO 830
  84. 850  IF ANS$ = "m" OR ANS$ = "M" THEN GOTO 890
  85. 860  CLS:LOCATE 5,8
  86. 870  INPUT "Enter Slide duration in seconds - max 60 ";SECS
  87. 880  IF SECS > 60 THEN CLS:LOCATE 10,15:PRINT "Wrong!!!!  Try again!";:GOTO 740
  88. 890  LOCATE 5,8
  89. 900  PRINT "Do you want a Printout of the slides?         "
  90. 910  LOCATE 7,28:PRINT "Enter Y or N "
  91. 920  ZZZ$=INKEY$:IF LEN(ZZZ$)<>1 THEN 920
  92. 930  IF INSTR("YyNn",ZZZ$)<1 THEN BEEP:GOTO 920
  93. 940  IF ZZZ$ = "Y" OR ZZZ$ = "y" THEN PRTSC$ = "Y"
  94. 950  IF PRTSC$ = "N" THEN GOTO 1020
  95. 960  LOCATE 5,8
  96. 970  PRINT "Do you want the prints identified?            "
  97. 980  LOCATE 7,28:PRINT "Enter Y or N "
  98. 990  ZYZ$=INKEY$:IF LEN(ZYZ$)<>1 THEN 990
  99. 1000  IF INSTR("YyNn",ZYZ$)<1 THEN BEEP:GOTO 920
  100. 1010  IF ZYZ$ = "Y" OR ZYZ$ = "y" THEN LABL$ = "Y"
  101. 1020  IF ANS$ = "m" OR ANS$ = "M" THEN GOTO 1400
  102. 1030  WIDTH 80:COLOR 0,0:CLS
  103. 1040  FILES DRIV$+"*.PIC"
  104. 1050  CLINE1 = CSRLIN
  105. 1060  D=0
  106. 1070  LOCATE 1,1,1
  107. 1080  FOR I = 2 TO CLINE1    'IBM BASICA Line
  108. 1090  'FOR I = 1 TO CLINE1   'COMPAQ BASICA Line
  109. 1100  FOR B = 1 TO 72 STEP 18  'IBM BASICA Line
  110. 1110  'FOR B = 1 TO 78 STEP 13  'COMPAQ BASICA Line
  111. 1120  D=D+1
  112. 1130  FOR N = 0 TO 11
  113. 1140  T = SCREEN(I,(B+N)):F$(D)=F$(D)+CHR$(T)
  114. 1150  NEXT N
  115. 1160  IF LEFT$(F$(D),1)=" " THEN D=D-1 :GOTO 1200
  116. 1170  F$(D)= DRIV$+F$(D)
  117. 1180  NEXT B
  118. 1190  NEXT I
  119. 1200  ' THIS ALPHABETIZES THE ARRAY
  120. 1210  LAST = D
  121. 1220  FOR X=1 TO D-1:FOR Y=X+1 TO D:IF F$(Y)<F$(X) THEN SWAP F$(X),F$(Y)
  122. 1230  NEXT Y:NEXT X
  123. 1240  SCREEN 1,0
  124. 1250  FOR XX = 1 TO LAST
  125. 1260  BLOAD F$(XX)
  126. 1270  IF PRTSC$ = "Y" THEN GOSUB 1630
  127. 1280  GOSUB 1350
  128. 1290  CLS
  129. 1300  NEXT XX
  130. 1310  'BLOAD "CLOSE.SCR"
  131. 1320  'FOR THIS = 1 TO 3000:NEXT THIS
  132. 1330  'SCREEN ,1:WIDTH 80:COLOR 7,0,0:LOCATE 24:STOP
  133. 1340  SYSTEM
  134. 1350  IF MA$ = "m" THEN GOTO 1490
  135. 1360  CURR = VAL(MID$(TIME$,7,2))
  136. 1370  ENDT = CURR + SECS
  137. 1380  IF ENDT > 59 THEN ENDT = ENDT - 60
  138. 1390  IF ENDT = VAL(MID$(TIME$,7,2)) THEN RETURN ELSE 1390
  139. 1400  CLS:LOCATE 5,12:PRINT "Use Grey Plus Key `+' to advance slide."
  140. 1410  LOCATE 7,12:PRINT "Use Grey Minus Key `-' to move backward."
  141. 1420  LOCATE 9,12:PRINT "Use Function Keys 1 thru 8 to Change Background Color"
  142. 1430  LOCATE 11,12:PRINT "Use Function Keys 9 and 10 to Change Pallette"
  143. 1440  LOCATE 19,12:PRINT "Press Space Bar to begin Show!"
  144. 1450  SP$=INKEY$:IF LEN(SP$)<>1 THEN 1450
  145. 1460  IF SP$ <> " " THEN 1450
  146. 1470  MA$="m"
  147. 1480  GOTO 1030
  148. 1490  RICH$=INKEY$:IF LEN(RICH$)<>1 THEN 1490
  149. 1500  IF RICH$ = "+" THEN RETURN
  150. 1510  IF RICH$ = "-" THEN XX=XX-2:GOSUB 1730:RETURN
  151. 1520  GOTO 1490
  152. 1530  COLOR 0:RETURN
  153. 1540  COLOR 1:RETURN
  154. 1550  COLOR 2:RETURN
  155. 1560  COLOR 3:RETURN
  156. 1570  COLOR 4:RETURN
  157. 1580  COLOR 5:RETURN
  158. 1590  COLOR 6:RETURN
  159. 1600  COLOR 7:RETURN
  160. 1610  COLOR ,1:RETURN
  161. 1620  COLOR ,2:RETURN
  162. 1630  SLN = SLN+1
  163. 1640  PRTSC(0) = &H5CD
  164. 1650  PRTSC(1) = &HCB
  165. 1660  P = VARPTR(PRTSC(0))
  166. 1670  CALL P
  167. 1680  FOR LIN = 1 TO 8:LPRINT " ":NEXT LIN
  168. 1690  FX$=RIGHT$(F$(XX),12)
  169. 1700  IF LABL$ = "Y" THEN LPRINT  "             Slide Number ";SLN;"   File name - ";FX$
  170. 1710  LPRINT CHR$(12)
  171. 1720  RETURN
  172. 1730  IF XX =-1 THEN XX=0
  173. 1740  RETURN
  174.